home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / comp / literal.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  6.9 KB  |  296 lines  |  [TEXT/ttxt]

  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: literal.c,v 1.11 94/10/05 20:55:21 nkramer Exp $
  27. *
  28. * This file implements the various kinds of literal constants.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33.  
  34. #include "mindycomp.h"
  35. #include "literal.h"
  36. #include "lose.h"
  37.  
  38. struct literal_list {
  39.     struct literal *head;
  40.     struct literal **tail;
  41. };
  42.  
  43.  
  44. struct literal *make_true_literal(void)
  45. {
  46.     struct literal *res = malloc(sizeof(struct literal));
  47.  
  48.     res->kind = literal_TRUE;
  49.     res->next = NULL;
  50.     res->line = 0;
  51.  
  52.     return res;
  53. }
  54.  
  55. struct literal *make_false_literal(void)
  56. {
  57.     struct literal *res = malloc(sizeof(struct literal));
  58.  
  59.     res->kind = literal_FALSE;
  60.     res->next = NULL;
  61.     res->line = 0;
  62.  
  63.     return res;
  64. }
  65.  
  66. struct literal *make_unbound_literal(void)
  67. {
  68.     struct literal *res = malloc(sizeof(struct literal));
  69.  
  70.     res->kind = literal_UNBOUND;
  71.     res->next = NULL;
  72.     res->line = 0;
  73.  
  74.     return res;
  75. }
  76.  
  77. struct literal *make_string_literal(char *str)
  78. {
  79.     int len = strlen(str);
  80.     struct string_literal *res = malloc(sizeof(struct string_literal)
  81.                     + len + 1 - sizeof(res->chars));
  82.  
  83.     res->kind = literal_STRING;
  84.     res->next = NULL;
  85.     res->line = 0;
  86.     res->length = len;
  87.  
  88.     strcpy((char *)res->chars, str);
  89.  
  90.     return (struct literal *)res;
  91. }
  92.  
  93. struct literal *make_character_literal(int c)
  94. {
  95.     struct character_literal *res = malloc(sizeof(struct character_literal));
  96.  
  97.     res->kind = literal_CHARACTER;
  98.     res->next = NULL;
  99.     res->line = 0;
  100.     res->value = c;
  101.  
  102.     return (struct literal *)res;
  103. }
  104.  
  105. struct literal *make_integer_literal(long value)
  106. {
  107.     struct integer_literal *res = malloc(sizeof(struct integer_literal));
  108.  
  109.     res->kind = literal_INTEGER;
  110.     res->next = NULL;
  111.     res->line = 0;
  112.     res->value = value;
  113.  
  114.     return (struct literal *)res;
  115. }
  116.  
  117. struct literal *make_symbol_literal(struct symbol *sym)
  118. {
  119.     struct symbol_literal *res = malloc(sizeof(struct symbol_literal));
  120.  
  121.     res->kind = literal_SYMBOL;
  122.     res->next = NULL;
  123.     res->line = 0;
  124.     res->symbol = sym;
  125.  
  126.     return (struct literal *)res;
  127. }
  128.  
  129. struct literal
  130.     *make_dotted_list_literal(struct literal_list *guts, struct literal *tail)
  131. {
  132.     struct list_literal *res = malloc(sizeof(struct list_literal));
  133.  
  134.     res->kind = literal_LIST;
  135.     res->next = NULL;
  136.     res->line = 0;
  137.     if (tail != NULL && tail->kind == literal_LIST) {
  138.     *guts->tail = ((struct list_literal *)tail)->first;
  139.     free(tail);
  140.     res->tail = NULL;
  141.     }
  142.     else
  143.     res->tail = tail;
  144.     res->first = guts->head;
  145.  
  146.     free(guts);
  147.  
  148.     return (struct literal *)res;
  149. }
  150.  
  151. struct literal *make_list_literal(struct literal_list *guts)
  152. {
  153.     return make_dotted_list_literal(guts, NULL);
  154. }
  155.  
  156. struct literal *make_vector_literal(struct literal_list *guts)
  157. {
  158.     struct vector_literal *res = malloc(sizeof(struct vector_literal));
  159.  
  160.     res->kind = literal_VECTOR;
  161.     res->next = NULL;
  162.     res->line = 0;
  163.     res->first = guts->head;
  164.  
  165.     free(guts);
  166.  
  167.     return (struct literal *)res;
  168. }
  169.  
  170. struct literal_list *make_literal_list(void)
  171. {
  172.     struct literal_list *res = malloc(sizeof(struct literal_list));
  173.  
  174.     res->head = NULL;
  175.     res->tail = &res->head;
  176.  
  177.     return res;
  178. }
  179.  
  180. struct literal_list *add_literal(struct literal_list *list,
  181.                  struct literal *literal)
  182. {
  183.     *list->tail = literal;
  184.     list->tail = &literal->next;
  185.  
  186.     return list;
  187. }
  188.  
  189. void free_literal(struct literal *literal)
  190. {
  191.     struct literal *part, *next;
  192.  
  193.     switch (literal->kind) {
  194.       case literal_SYMBOL:
  195.       case literal_INTEGER:
  196.       case literal_SINGLE_FLOAT:
  197.       case literal_DOUBLE_FLOAT:
  198.       case literal_EXTENDED_FLOAT:
  199.       case literal_CHARACTER:
  200.       case literal_STRING:
  201.       case literal_TRUE:
  202.       case literal_FALSE:
  203.       case literal_UNBOUND:
  204.     break;
  205.       case literal_LIST:
  206.     if (((struct list_literal *)literal)->tail)
  207.         free_literal(((struct list_literal *)literal)->tail);
  208.     /* Fall though */
  209.       case literal_VECTOR:
  210.     for (part = ((struct vector_literal *)literal)->first;
  211.          part != NULL;
  212.          part = next) {
  213.         next = part->next;
  214.         free_literal(part);
  215.     }
  216.     break;
  217.       default:
  218.     lose("Bogus literal kind.");
  219.     }
  220.     free(literal);
  221. }
  222.  
  223. struct literal *dup_literal(struct literal *literal)
  224. {
  225.     size_t size = 0;
  226.     struct literal *res, *tail;
  227.     struct literal *l, **prev;
  228.  
  229.     switch (literal->kind) {
  230.       case literal_SYMBOL:
  231.     size = sizeof(struct symbol_literal);
  232.     break;
  233.       case literal_INTEGER:
  234.     size = sizeof(struct integer_literal);
  235.     break;
  236.       case literal_SINGLE_FLOAT:
  237.     size = sizeof(struct single_float_literal);
  238.     break;
  239.       case literal_DOUBLE_FLOAT:
  240.     size = sizeof(struct double_float_literal);
  241.     break;
  242.       case literal_EXTENDED_FLOAT:
  243.     size = sizeof(struct extended_float_literal);
  244.     break;
  245.       case literal_CHARACTER:
  246.     size = sizeof(struct character_literal);
  247.     break;
  248.       case literal_STRING:
  249.     size = sizeof(struct string_literal)
  250.         + ((struct string_literal *)literal)->length + 1
  251.           - sizeof(((struct string_literal *)literal)->chars);
  252.     break;
  253.       case literal_TRUE:
  254.       case literal_FALSE:
  255.       case literal_UNBOUND:
  256.     size = sizeof(struct literal);
  257.     break;
  258.       case literal_LIST:
  259.     size = sizeof(struct list_literal);
  260.     break;
  261.       case literal_VECTOR:
  262.     size = sizeof(struct vector_literal);
  263.     break;
  264.       default:
  265.     lose("Bogus literal kind.");
  266.     }
  267.  
  268.     res = malloc(size);
  269.     memcpy(res, literal, size);
  270.  
  271.     switch (literal->kind) {
  272.       case literal_LIST:
  273.     tail = ((struct list_literal *)literal)->tail;
  274.     if (tail != NULL)
  275.         ((struct list_literal *)res)->tail = dup_literal(tail);
  276.     else
  277.         ((struct list_literal *)res)->tail = NULL;
  278.     /* Fall though */
  279.       case literal_VECTOR:
  280.     prev = &((struct vector_literal *)res)->first;
  281.     for (l = *prev; l != NULL; l = l->next) {
  282.         *prev = dup_literal(l);
  283.         prev = &(*prev)->next;
  284.     }
  285.     break;
  286.       default:
  287.     break;
  288.     }
  289.  
  290.     res->next = NULL;
  291.  
  292.     return res;
  293. }
  294.         
  295.     
  296.